home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
bipl.zip
/
PROGS.ZIP
/
PT.ICN
< prev
next >
Wrap
Text File
|
1992-09-28
|
37KB
|
1,028 lines
############################################################################
#
# File: pt.icn
#
# Subject: Program to produce parse table generator
#
# Author: Deeporn H. Beardsley
#
# Date: December 10, 1988
#
###########################################################################
#
# See pt.man for a description of functionality as well as input and
# output format.
#
############################################################################
#**********************************************************************
#* *
#* Main procedure as well as *
#* a routine to generate production table, nonterminal, terminal *
#* and epsilon sets from the input grammar *
#**********************************************************************
#
# 1. Data structures:-
#
# E.g. Grammar:-
#
# A -> ( B )
# A -> B , C
# A -> a
# B -> ( C )
# B -> C , A
# B -> b
# C -> ( A )
# C -> A , B
# C -> c
#
# prod_table prod
# __________________ _____ _____ _____
# | | | num | 1 | | 2 | | 3 |
# | "A" | ------|-->[ |---| ,|---| ,|---| ]
# | | | rhs |_|_| |_|_| |_|_|
# | | | | | v
# | | | | v ["a"]
# | | | v ["B",",","C"]
# | | | ["(","B",")"]
# |_____|__________| _____ _____ _____
# | | | num | 4 | | 5 | | 6 |
# | "B" | ------|-->[ |---| ,|---| ,|---| ]
# | | | rhs |_|_| |_|_| |_|_|
# | | | | | v
# | | | | v ["b"]
# | | | v ["C",",","A"]
# | | | ["(","C",")"]
# |_____|__________| _____ _____ _____
# | | | num | 7 | | 8 | | 9 |
# | "C" | ------|-->[ |---| ,|---| ,|---| ]
# | | | rhs |_|_| |_|_| |_|_|
# | | | | | v
# | | | | v ["c"]
# | | | v ["A",",","B"]
# | | | ["(","A",")"]
# ------------------
#
# __________________
# firsts | "A" | ------|-->("(", "a", "b", "c")
# |-----|----------|
# | "B" | ------|-->("(", "a", "b", "c")
# |-----|----------|
# | "C" | ------|-->("(", "a", "b", "c")
# ------------------
#
# _______
# NTs | ---|-->("A", "B", "C")
# -------
#
# _______
# Ts | ---|-->("(", "a", "b", "c")
# -------
#
# 2. Algorithm:-
#
# get_productions() -- build productions table (& NT, T
# and epsilon sets):-
# open grammar file or from stdin
# while can get an input line, i.e. production, do
# get LHS token and use it as entry value to table
# (very first LHS token is start symbol of grammar)
# (enter token in nonterminal, NT, set)
# get each RHS token & form a list, put this list
# in the list, i.e.assigned value, of the table
# (enter each RHS token in terminal, T, set)
# (if first RHS token is epsilon
# enter LHS token in the epsilon set)
# (T is the difference of T and NT)
# close grammar file
#
#**********************************************************************
global prod_table, NTs, Ts, firsts, stateL, itemL
global StartSymbol, start, eoi, epsilon
global erratta # to list all items in a state (debugging)
record prod(num, rhs) # assigned values for prod_table
record arc(From, To) # firsts computation -- closure
record item(prodN, lhs, rhs1, rhs2, NextI)
record state(C_Set, I_Set, goto)
procedure main(opt_list)
local opt
start := "START" # start symbol for augmented grammar
eoi := "EOI" # end-of-input token (constant)
epsilon := "EPSILON" # epsilon token (constant)
prod_table := table() # productions
NTs := set() # non-terminals
Ts := set() # terminals
firsts := table() # nonterminals only; first(T) = {T}
get_firsts(get_productions())
if /StartSymbol then exit(0) # input file empty
write_prods()
if opt := (!opt_list == "-nt") then
write_NTs()
if opt := (!opt_list == "-t") then
write_Ts()
if opt := (!opt_list == "-f") then
write_firsts()
if opt := (!opt_list == "-e") then
erratta := 1
else
erratta := 0
stateL := list() # not popped, only for referencing
itemL := list() # not popped, only for referencing
state0() # closure of start production
gotos() # sets if items
p_table() # output parse table
end
procedure get_productions()
local Epsilon_Set, LHS, first_RHS_token, grammarFile, line, prods, temp_list
local token, ws
prods := 0 # for enumeration of productions
ws := ' \t'
Epsilon_Set := set() # NT's that have epsilon production
grammarFile := (open("grammar") | &input)
while line := read(grammarFile) do {
first_RHS_token := &null # to detect epsilon production
temp_list := [] # RHS of production--list of tokens
line ? {
tab(many(ws))
LHS := tab(upto(ws)) # LHS of production--nonterminal
/firsts[LHS] := set()
/StartSymbol := LHS # start symbol for unaug. grammar
insert(NTs, LHS) # collect nonterminals
tab(many(ws)); tab(match("->")); tab(many(ws))
while put(temp_list, token := tab(upto(ws))) do {
/first_RHS_token := token
insert(Ts, token) # put all RHS tokens into T set for now
tab(many(ws))
}
token := tab(0) # get last RHS non-ws token
if *token > 0 then {
put(temp_list, token)
/first_RHS_token := token
insert(Ts, token)
}
Ts --:= NTs # set of terminals
delete(Ts, epsilon) # EPSILON is not a terminal
/prod_table[LHS] := []
put(prod_table[LHS], prod(prods +:=1, temp_list))
}
if first_RHS_token == epsilon then
insert(Epsilon_Set, LHS)
}
if not (grammarFile === &input) then
close(grammarFile)
return Epsilon_Set
end
#**********************************************************************
#* *
#* Routines to generate first sets *
#**********************************************************************
# 1. Data structures:-
# (see also data structures in mainProds.icn)
#
# __________________
# needs | "A" | ------|-->[B]
# |-----|----------|
# | "B" | ------|-->[C]
# |-----|----------|
# | "C" | ------|-->[A]
# ------------------
#
# has_all_1st
# _______
# | ---|-->("A", "C")
# -------
#
#
# G |-----------------------|
# | __________________ v
# | | "A" | ------|-->(B)<--------|
# | |-----|----------| |
# |--|--- | ----|-->"A" |
# |-----|----------| |
# | "B" | ------|-->(C)<-----| |
# |-----|----------| | |
# | (C) | ------|-->"B" | |
# |-----|----------| | |
# | "C" | ------|-->(A)<--| | |
# |-----|----------| | | |
# | (A) | ------|-->"C" | | |
# ------------------ | | |
# | | |
# closure_table | | |
# __________________ | | |
# | "A" | ------|-->( ----| ,| ,| )
# |-----|----------|
# | "B" | ------|-->( as above )
# |-----|----------|
# | "C" | ------|-->( as above )
# ------------------
#
# (Note: G table: the entry values (B) and (C) should be analogous
# to that of '(A)'.)
#
# 2. Algorithms:-
#
# 2.1 Firsts sets (note: A is nonterminal &
# beta is a string of symbols):-
# For definition, see Aho, et al, Compilers...
# Addison-Wesley, 1986, p.188)
# for each production A -> beta (use production table above)
# loop1
# case next RHS token, B, is
# epsilon : do nothing, break from loop1
# terminal : insert it in first(A), break from loop1
# nonterminal: put B in needs[A] table
# if B in epsilon set & last RHS token
# insert A in epsilon set
# break from loop1
# loop1
# collect has_all_1st set (NTs whose first is fully defined
# i.e. NTs not entry value of needs table)
# Loop2 (fill_firsts)
# for each NT B in each needs[A]
# if B is in has_all_1st
# insert all elements of first(B) in first(A)
# delete B from needs[A]
# if needs[A] is empty
# insert A in has_all_1st
# if *has_all_1st set equal to *NTs set
# exit loop2
# if *has_all_1st set not equal to *NTs set
# if *has_all_1st not changed from beginning of loop2
# (i.e. circular dependency e.g.
# needs[X] = [Y]
# needs[Y] = [Z]
# needs[Z] = [X])
# find closure of each A
# find a set of A's whose closure sets are same
# pool their firsts together
# add pooled firsts to first set of each A
# goto loop2
#
#
# This algorithm is implemented by the following procedures:-
#
# get_firsts(Epsilon_Set) -- compute first sets of all
# NTs, given the NTs that have epsilon productions.
#
# fill_firsts(needs) -- given the needs table that says
# which first set contains the elements of other
# first set(s), complete computation of first sets.
#
# buildgraph(tempL) -- given the productions in tempL,
# build table G above.
#
# closure(G, S1, S2) -- given the productions in tempL,
# the entry value S1 and its closure set S2, build
# closure_table.
#
# addnode(n, t) -- given table t ( G, actually), and
# 1. entry value of n, enter its assigned value in
# in table t to be a set (empty, for now)
# 2. use t[n] (in 1) as the entry value, enter its
# assigned value in table t to be "n".
#
# closed_loop(G, SS, closure_table, tempL_i) -- given
# table G, closure_table and a nonterminal tempL_i
# that still needs its firsts completed, return the
# set SS of nonterminals if each and every of these
# nonterminals has identical closure set.
#
# finish_firsts(closed_set) -- given the set closed_set
# of nonterminals where every member of of the set
# has identical closure set, pool the elements
# (terminals) from their so-far known firsts sets
# together and reenter this pooled value into their
# firsts sets (firsts table).
#
# 2.2 Note that buildgraph(), closure() and addnode()
# are either exactly or essentially the same as
# given in class (by R. Griswold).
#
#**********************************************************************
procedure get_firsts(Epsilon_Set)
local needs, prods, i, j, k, token
needs := table()
prods := sort(prod_table, 3)
every i := 1 to *prods by 2 do # production(s) of a NT
every j := 1 to *prods[i+1] do # RHS of each production
every k := 1 to *prods[i+1][j].rhs do # and each token
if ((token := prods[i+1][j].rhs[k]) == epsilon) then
break # did in get_productions
else if member(Ts, token) then { # leading token on RHS
insert(firsts[prods[i]], token) # e.g. A -> ( B )
break
}
else { #if member(NTs, token) then # A -> B a C
/needs[prods[i]] := []
put(needs[prods[i]], token)
if not (member(Epsilon_Set, token)) then # not B -> EPSILON
break
if k = *prods[i+1][j].rhs then # all RHS tokens are NTs &
insert(Epsilon_Set, prods[i]) # each has epsilon production
}
fill_firsts(needs) # do firsts that contain firsts of other NT(s)
every insert(firsts[!Epsilon_Set], epsilon) # add epsilon last
end
procedure fill_firsts(needs)
local G, L, NTy, SS, closed_set, closure_table, has_all_1st, i, lhs
local new_temp, rhs, size_has_all_1st, ss, ss_table, tempL, x
closure_table := table()
has_all_1st := copy(NTs) # set of NTs whose firsts fully defined
tempL := sort(needs, 3)
every i := 1 to *tempL by 2 do
delete(has_all_1st, tempL[i])
repeat {
ss := ""
ss_table := table()
size_has_all_1st := *has_all_1st
new_temp := list()
while lhs := pop(tempL) do {
rhs := pop(tempL)
L := list()
while NTy := pop(rhs) do
if NTy ~== lhs then
if member(has_all_1st, NTy) then
firsts[lhs] ++:= firsts[NTy]
else
put(L, NTy)
if *L = 0 then
insert(has_all_1st, lhs)
else {
put(new_temp, lhs)
put(new_temp, L)
}
}
tempL := new_temp
if *has_all_1st = *NTs then
break
if size_has_all_1st = *has_all_1st then {
G := buildgraph(tempL)
every i := 1 to *tempL by 2 do
closure_table[tempL[i]] := closure(G, tempL[i])
every i := 1 to *tempL by 2 do {
closed_set := set()
SS := set([tempL[i]])
every x := !closure_table[tempL[i]] do
insert(SS, G[x])
closed_set := closed_loop(G,SS,closure_table,tempL[i])
if \closed_set then {
finish_firsts(closed_set)
every insert(has_all_1st, !closed_set)
break
}
}
}
}
return
end
procedure buildgraph(tempL) # modified from the original version
local arclist, nodetable, x, i
arclist := [] # by Ralph Griswold
nodetable := table()
every i := 1 to *tempL by 2 do {
every x := !tempL[i+1] do {
addnode(tempL[i], nodetable)
addnode(x, nodetable)
put(arclist, arc(tempL[i], x))
}
}
while x := get(arclist) do
insert(nodetable[x.From], nodetable[x.To])
return nodetable
end
procedure closure(G, S1, S2) # modified from the original version
local S
/S2 := set([G[S1]]) # by Ralph Griswold
every S := !(G[S1]) do
if not member(S2, S) then {
insert(S2, S)
closure(G, G[S], S2)
}
return S2
end
procedure addnode(n, t) # author: Ralph Griswold
local S
if /t[n] then {
S := set()
t[n] := S
t[S] := n
}
return
end
procedure closed_loop(G, SS, closure_table, tempL_i)
local S, x, y
delete(SS, tempL_i)
every x := !SS do {
S := set()
every y := !closure_table[x] do
insert(S, G[y])
delete(S, tempL_i)
if *S ~= *SS then fail
every y := !S do
if not member(SS, y) then fail
}
return insert(SS, tempL_i)
end
procedure finish_firsts(closed_set)
local S, x
S := set()
every x := !closed_set do
every insert(S, !firsts[x])
every x := !closed_set do
every insert(firsts[x], !S)
end
#**********************************************************************
#* *
#* Routines to generate states *
#**********************************************************************
#
# 1. Data structures:-
#
# E.g. Augmented grammar:-
#
# START -> S (production 0)
# S -> ( S ) (production 1)
# S -> ( ) (production 2)
#
# Item is a record of 5 fields:-
# Example of an item: itemL[1] is [START->.S , $]
# prodN represents the production number
# lhs represents the nonterminal at the
# left hand side of the production
# rhs1 represents the list of tokens seen so
# far (i.e. left of the dot in item)
# rhs2 represents the list of tokens yet to be
# seen (i.e. right of the dot in item)
# NextI represents the next input symbol
# (the end of input symbol $ is
# represented by EOI.)
#
#
# item
# _________ _________
# prodN| 0 | | 1 |
# |-------| |-------|
# lhs |"START"| | "S" |
# _______ |-------| |-------|
# itemL | ---|-->[ rhs1 | ---|---| , | -----|---| , ... ]
# ------- |-------| | |-------| |
# rhs2 | ---|-| | | -----|-| |
# |-------| | | |-------| | |
# NextI| "EOI" | | | | "EOI" | | |
# --------- | | --------- | |
# | | | |
# | | | |
# | v | v
# | [] | []
# | |
# v v
# ["S"] ["(", "S", ")"]
#
# state
# _______
# C_Set| ---|-----|
# _______ |-----| |
# stateL | ---|-->[ I_Set| ---|---| | , ... ]
# ------- |-----| | |
# goto | ---|-| | |
# ------- | | |
# | | v
# | | (1, 2, 3)
# | v
# | (1)
# v
# __________________
# | "A" | 5 |
# |-----|----------|
# | "B" | 2 |
# |-----|----------|
# | "C" | 3 |
# ------------------
#
#
# (Note: 1. The above 2 lists:-
# -- are not to be popped
# -- new elements are put in the back
# -- index represents the identity of the element
# -- no duplicate elements in either list
# 2. The state record:-
# I_Set represents J in function goto(I,x) in
# Compiler, Aho, et al, Addison-Wesley, 1986,
# p. 232.
# C_Set represents the closure if I_Set.
# goto is part of the goto table and the shift
# actions of the final parse table.)
# 3. The 1 in C_Set and I_Set in the diagrams above refer
# the same (physical) element.
#
# 2. Algorithms:-
#
# state0() -- create itemL[1] and stateL[1] as well as its
# closure.
#
# item_num(P_num, N_lhs, N_rhs1, N_rhs2, NI) --
# if the item with the values given in the
# argument list already exists in itemL list,
# it returns the index of the item in the list,
# if not, it builds a new item and put it at the
# end of the list and returns the new index.
#
# prod_equal(prod1, prod2) -- prod1 and prod2 are lists of
# strings; fail if they are not the same.
#
# state_closure(st) -- given the item set (I_set of the state
# st), set the value of C_Set of st to the closure
# of this item set. For definition of closure,
# see Aho, et al, Compilers..., Addison-Wesley,
# 1986, pp. 222-224)
#
# new_item(st,O_itm) -- given the state st and an item O_itm,
# suppose the item has the following configuration:-
# [A -> B.CD,x]
# where CD is a string of terminal and nonterminal
# tokens. If C is a nonterminal,
# for each C -> E in the grammar, and
# for each y in first(Dx), add the new item
# [C -> .E,y]
# to the C_Set of st.
#
# all_firsts(itm) -- given an item itm and suupose it has the
# following configuration:-
# [A -> B.CD,x]
# where D is a string of terminal and nonterminal
# tokens. The procedure returns first(Dx).
#
# gotos() -- For definition of goto operation, see Aho, et al,
# Compilers..., Addison-Wesley, 1986, pp. 224-227)
# The C = {closure({[S'->S]})} is set up by the
# state0()
# call in the main procedure.
#
# It also compiles the goto table. The errata part
# (last section of the code in this procedure) is
# for debugging purposes and is left intact for now.
#
# moved_item(itm) -- given the item itm and suppose it has the
# following configuration:-
# [A -> B.CD,x]
# where D is a string of terminal and nonterminal
# tokens. The procedure builds a new item:-
# [A -> BC.D,x]
# It then looks up itemL to see if it already is
# in it. If so, it'll return its index in the list,
# else, it'll put it in the back of the list and
# return this new index. (This is done by calling
# item_num()).
#
# exists_I_Set(test) -- given the I_Set test, look in the stateL
# list and see if any state does contain similar
# I_Set, if so, return its index to the stateL list,
# else fail.
#
# set_equal(set1, set2) -- set1 and set2 are sets of integers;
# return set1 if the two sets have the same elements
# else fail. (It is used strictly in comparison of
# I_Sets).
#
#
#**********************************************************************
procedure state0()
local itm, st
itm := item_num(0, start, [], [StartSymbol], eoi)
st := state(set(), set([itm]), table())
put(stateL, st)
state_closure(st) # closure on initial state
end
procedure item_num(P_num, N_lhs, N_rhs1, N_rhs2, NI)
local itm, i
itm := item(P_num, N_lhs, N_rhs1, N_rhs2, NI)
every i := 1 to *itemL do {
if itm.prodN ~== itemL[i].prodN then next
if itm.lhs ~== itemL[i].lhs then next
if not prod_equal(itm.rhs1, itemL[i].rhs1) then next
if not prod_equal(itm.rhs2, itemL[i].rhs2) then next
if itm.NextI == itemL[i].NextI then return i
}
put(itemL, itm)
return *itemL
end
procedure prod_equal(prod1, prod2) # compare 2 lists of strings
local i
if *prod1 ~= *prod2 then fail
every i := 1 to *prod1 do
if prod1[i] ~== prod2[i] then fail
return
end
procedure state_closure(st)
local addset, more_set, i
st.C_Set := copy(st.I_Set)
addset := copy(st.C_Set)
while *addset > 0 do {
more_set := set()
every i := !addset do
if (itemL[i].rhs2[1] ~== epsilon) then
if member(NTs, itemL[i].rhs2[1]) then
more_set ++:= new_item(st,itemL[i])
addset := more_set
}
end
procedure new_item(st,O_itm)
local N_Lhs, N_Rhs1, N_prod, NxtInput, T_itm, i, rtn_set
rtn_set := set()
NxtInput := all_firsts(O_itm)
N_Lhs := O_itm.rhs2[1]
N_Rhs1 := []
every N_prod := !prod_table[N_Lhs] do
every i := !NxtInput do {
T_itm := item_num(N_prod.num, N_Lhs, N_Rhs1, N_prod.rhs, i)
if not member(st.C_Set, T_itm) then {
insert(st.C_Set, T_itm)
insert(rtn_set, T_itm)
}
}
return rtn_set
end
procedure all_firsts(itm)
local rtn_set, i
if *itm.rhs2 = 1 then
return set([itm.NextI])
rtn_set := set()
every i := 2 to *itm.rhs2 do
if member(Ts, itm.rhs2[i]) then
return insert(rtn_set, itm.rhs2[i])
else {
rtn_set ++:= firsts[itm.rhs2[i]]
if not member(firsts[itm.rhs2[i]], epsilon) then
return rtn_set
}
return insert(rtn_set, itm.NextI)
end
procedure gotos()
local New_I_Set, gost, i, i_num, j, j_num, looked_at, scan, st, st_num, x
st_num := 1
repeat{
looked_at := set()
scan := sort(stateL[st_num].C_Set)
every i := 1 to *scan do {
i_num := scan[i]
if member(looked_at, i_num) then next
insert(looked_at, i_num)
x := itemL[i_num].rhs2[1] # next LHS
if ((*itemL[i_num].rhs2 = 0) | (x == epsilon)) then next
New_I_Set := set([moved_item(itemL[i_num])])
every j := i+1 to *scan do {
j_num := scan[j]
if not member(looked_at, j_num) then
if (x == itemL[j_num].rhs2[1]) then {
insert(New_I_Set, moved_item(itemL[j_num]))
insert(looked_at, j_num)
}
}
if gost := exists_I_Set(New_I_Set) then
stateL[st_num].goto[x] := gost #add into goto
else { # add a new state
st := state(set(), New_I_Set, table())
put(stateL, st)
state_closure(st)
stateL[st_num].goto[x] := *stateL #add into goto
}
}
if erratta=1 then {
write("--------------------------------")
write("State ", st_num-1)
write_state(stateL[st_num])
}
st_num +:= 1
if st_num > *stateL then {
if erratta=1 then
write("--------------------------------")
return stateL
}
}
end
procedure moved_item(itm)
local N_Rhs1, N_Rhs2, i
N_Rhs1 := copy(itm.rhs1)
put(N_Rhs1, itm.rhs2[1])
N_Rhs2 := list()
every i := 2 to *itm.rhs2 do
put(N_Rhs2, itm.rhs2[i])
return item_num(itm.prodN, itm.lhs, N_Rhs1, N_Rhs2, itm.NextI)
end
procedure exists_I_Set(test)
local st
every st := 1 to *stateL do
if set_equal(test, stateL[st].I_Set) then return st
fail
end
procedure set_equal(set1, set2)
local i
if *set1 ~= *set2 then fail
every i := !set2 do
if not member(set1, i) then fail
return set1
end
#**********************************************************************
#* *
#* Miscellaneous write routines *
#**********************************************************************
# The following are write routines; some for optional output
# while others are for debugging purposes.
#
# write_item(itm) -- write the contents if item itm.
# write_state(st) -- write the contents of state st.
# write_tbl_list(out) -- (for debugging purposes only).
# write_prods()-- write the enmnerated grammar productions.
# write_NTs() -- write the set of nonterminals.
# write_Ts() -- write the set of terminals.
# write_firsts() -- write the first sets of each nonterminal.
# write_needs(L) -- write the list of all nonterminals and the
# associated nonterminals whose first sets
# it still needs to compute its own first
# set.
#
#**********************************************************************
procedure write_item(itm)
local i
writes("[(",itm.prodN,") ",itm.lhs," ->")
every i := !itm.rhs1 do writes(" ",i)
writes(" .")
every i := !itm.rhs2 do writes(" ",i)
writes(", ",itm.NextI,"]\n")
end
procedure write_state(st)
local i, tgoto
write("I_Set")
every i := ! st.I_Set do {
writes("Item ", i, " ")
write_item(itemL[i])
}
write()
write("C_Set")
every i := ! st.C_Set do {
writes("Item ", i, " ")
write_item(itemL[i])
}
tgoto := sort(st.goto, 3)
write()
write("Gotos")
every i := 1 to *tgoto by 2 do
write("Goto state ", tgoto[i+1]-1, " on ", tgoto[i])
end
procedure write_tbl_list(out)
local i, j
every i := 1 to *out by 2 do {
writes(out[i], ", [")
every j := *out[i+1] do {
if j ~= 1 then
writes(", ")
writes(out[i+1][j])
}
writes("]\n")
}
end
procedure write_prods()
local i, j, k, prods
prods := sort(prod_table, 3)
every i := 1 to *prods by 2 do
every j := 1 to *prods[i+1] do {
writes(right(string(prods[i+1][j].num),3," "),": ")
writes(prods[i], " ->")
every k := 1 to *prods[i+1][j].rhs do
writes(" ", prods[i+1][j].rhs[k])
writes("\n")
}
end
procedure write_NTs()
local temp_list
temp_list := sort(NTs)
write("\n")
write("nonterminal sets are:")
every write(|pop(temp_list))
end
procedure write_Ts()
local temp_list
temp_list := sort(Ts)
write("\n")
write("terminal sets are:")
every write(|pop(temp_list))
end
procedure write_firsts()
local temp_list, i, j, first_list
temp_list := sort(firsts, 3)
write("\nfirst sets:::::")
every i := 1 to *temp_list by 2 do {
writes(temp_list[i], ": ")
first_list := sort(temp_list[i+1])
every j := 1 to *first_list do
writes(" ", pop(first_list))
writes("\n\n")
}
end
procedure write_needs(L)
local i, temp
write("tempL : ")
every i := 1 to *L by 2 do {
writes(L[i], " ")
temp := copy(L[i+1])
every writes(|pop(temp))
writes("\n")
}
end
#**********************************************************************
#* *
#* Output the parse table routines *
#**********************************************************************
#
# p_table() -- output parse table: tablulated (vertical and
# horizontal lines, etc.) if the width is within
# 80 characters long else a listing.
#
# outline(size, out, st_num, T_list, NT_list) -- print the header;
# used in table form.
#
# border(size, T_list, NT_list, col) -- draw a horizontal line
# for the table form, given the table size that tells
# the length of each token given the lists of
# terminals and nonterminals. If the line is the
# last line of the table, col given is "-", else it
# is "-".
#
# outstate(st, out, T_list, NT_list) -- print the shift, reduce
# and goto for state st from information given in
# out, and the lists of terminals and nonterminals;
# used to output the parse table in the listing form.
#
#**********************************************************************
procedure p_table()
local NT_list, T_list, action, gs, i, itm, msize, out, s, size, st_num, tsize
T_list := sort(Ts)
put(T_list, eoi)
NT_list := sort(NTs)
size := table()
out := table()
if *stateL < 1000 then msize := 4
else if *stateL < 10000 then msize := 5
else msize := 6
tsize := 7
every s := !T_list do {
size[s] := *s
size[s] <:= msize
tsize +:= size[s] + 3
out[s] := s
}
every s := !NT_list do {
size[s] := *s
size[s] <:= msize
tsize +:= size[s] + 3
out[s] := s
}
write()
write()
write("PARSE TABLE")
write()
if tsize <= 80 then {
outline(size, out, 0, T_list, NT_list)
border(size, T_list, NT_list, "+")
}
every st_num := 1 to *stateL do {
out := table()
gs := sort(stateL[st_num].goto,3)
every i := 1 to * gs by 2 do { # do the shifts and gotos
if member(Ts, gs[i]) then
out[gs[i]] := "S" || string(gs[i+1]-1) # shift (action table)
else
out[gs[i]] := string(gs[i+1]-1) # for goto table
}
every itm := itemL[!stateL[st_num].C_Set] do {
if ((*itm.rhs2 = 0) | (itm.rhs2[1] == epsilon)) then {
if itm.prodN = 0 then
action := "ACC" # accept state
else
action := "R" || string(itm.prodN) # reduce (action table)
if /out[itm.NextI] then
out[itm.NextI] := action
else { # conflict
write(&errout, "Conflict on state ", st_num-1, " symbol ",
itm.NextI, " between ", action, " and ", out[itm.NextI])
write(&errout, " ", out[itm.NextI], " takes presidence")
}
}
}
if tsize <= 80 then
outline(size, out, st_num, T_list, NT_list)
else
outstate(st_num, out, T_list, NT_list)
}
end
procedure outline(size, out, st_num, T_list, NT_list)
local s
if st_num = 0 then
writes("State")
else
writes(right(string(st_num-1),5," "))
writes(" ||")
every s := !T_list do {
/out[s] := ""
writes(" ", center(out[s],size[s]," "), " |")
}
writes("|")
every s := !NT_list do {
/out[s] := ""
writes(" ", center(out[s],size[s]," "), " |")
}
write()
if st_num < * stateL then
border(size, T_list, NT_list, "+")
else
border(size, T_list, NT_list, "-")
end
procedure border(size, T_list, NT_list, col)
local s
writes("------", col, col)
every s := !T_list do
writes("-", center("",size[s],"-"),"-", col)
writes(col)
every s := !NT_list do
writes("-",center("",size[s],"-"), "-", col)
writes("\n")
end
procedure outstate(st, out, T_list, NT_list)
local s
write()
write("Actions for state ", st-1)
every s := !T_list do
if \out[s] then
if out[s][1] == "R" then
write(" On ", s, " reduce by production ", out[s][2:0])
else if out[s][1] == "A" then
write(" On ", s, " ACCEPT")
else
write(" On ", s, " shift to state ", out[s][2:0])
every s := !NT_list do
if \out[s] then
write(" On ", s, " Goto ", out[s])
write()
end
